home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IO Examples / Mandelbrot / Mandelbrot.icl < prev   
Encoding:
Modula Implementation  |  1996-12-18  |  7.0 KB  |  192 lines  |  [TEXT/3PRM]
  1. implementation module Mandelbrot
  2.  
  3. import StdReal,StdInt,StdMisc,StdBool,StdClass
  4. import FractalTypes, Complex
  5.  
  6. ::    FractalUpdArea
  7.     =    {    updlayer:: !Layer
  8.         ,    updgrain:: !GrainSize
  9.         ,    beginx    :: !Int
  10.         ,    endx    :: !Int
  11.         ,    endline    :: !Int
  12.         }
  13.  
  14. // Drawing the image grained.
  15. PaintSpot :: !Rectangle !Int !FunctionState !Picture -> Picture
  16. PaintSpot rect color {colours,depth} p
  17. |    color==depth    = PaintRectangle rect (RGB 0.0 0.0 0.0) p
  18. |    otherwise        = PaintRectangle rect (IndexToColor colours color) p
  19. where
  20.     PaintRectangle :: !Rectangle !Colour !Picture -> Picture      
  21.     PaintRectangle rect=:((x,y),(x`,y`)) rgb_color p
  22.     #    p                    = SetPenColour rgb_color p
  23.         p                    = MovePenTo (x,y) p
  24.     |    1==x`-x && 1==y`-y    = LinePenTo (x,y) p
  25.     |    otherwise            = FillRectangle rect p
  26.     
  27.     IndexToColor :: !Colours Int -> Colour
  28.     IndexToColor (rs,ri,gs,gi,bs,bi) color
  29.                 = RGB red green blue
  30.     where
  31.         red        = toReal (ri * ReverseBits (1 << rs) color 0) / rfac
  32.         green    = toReal (gi * ReverseBits (1 << gs) color 0) / gfac
  33.         blue    = toReal (bi * ReverseBits (1 << bs) color 0) / bfac
  34.         rfac    = toReal (32704 >> rs)
  35.         gfac    = toReal (32704 >> gs)
  36.         bfac    = toReal (32704 >> bs)
  37.         
  38.         ReverseBits :: !Int Int !Int -> Int
  39.         ReverseBits mask number result
  40.         |    mask>256                = result
  41.         |    (number bitand mask)==0    = ReverseBits mask` number result`
  42.         |    otherwise                = ReverseBits mask` number (inc result`)
  43.         where
  44.             mask`  = mask << 1
  45.             result`= result << 1
  46.  
  47. // Update a specific area of the image.
  48. UpdateFractalArea :: Rectangle *FractalState -> (*FractalState,DrawFunction)
  49. UpdateFractalArea rect state=:{funstate,drawstate={layer,grain,line}}
  50.                     = (state,LazyDrawArea upd firstline funstate)
  51. where
  52.     (upd,firstline)    = CalculateUpdate rect layer grain
  53.     
  54.     CalculateUpdate :: !Rectangle !Layer !GrainSize -> (!FractalUpdArea,!Int)
  55.     CalculateUpdate ((x1,y1),(x2,y2)) layer n
  56.                     = ({updlayer=layer,updgrain=n,beginx=beginx,endx=endx,endline=endline},beginline)
  57.     where
  58.         beginx        = x1 / n*n
  59.         endx        = if (x2 mod n == 0) x2 ((x2/n+1)*n)
  60.         beginline    = y1 / n*n
  61.         endline        = if (y2 mod n == 0) y2 ((y2/n+1)*n)
  62.     
  63.     LazyDrawArea :: !FractalUpdArea !Int !FunctionState !Picture -> Picture
  64.     LazyDrawArea upd=:{updlayer,updgrain,beginx,endx,endline} line state pic
  65.     |    line>=endline    = pic
  66.     |    otherwise        = LazyDrawArea upd (line+updgrain) state (LazyDrawSpots` (beginx,line) endx updgrain updlayer state pic)
  67.     where
  68.         LazyDrawSpots` :: !Point !Int !GrainSize !Layer !FunctionState !Picture -> Picture
  69.         LazyDrawSpots` point=:(x,y) h n l funcs pic
  70.         |    x>h            = pic
  71.         |    otherwise    = LazyDrawSpots` (xn,y) h n l funcs (PaintSpot ((x,y),(xn,yn)) value funcs pic)
  72.         where
  73.             xn            = x+n
  74.             yn            = y+n
  75.             value        = Fractal_color point funcs
  76.  
  77. // The actual calculations
  78. Fractal_color :: !Point !FunctionState -> Int
  79. Fractal_color (x,y) {area={center=(centerx,centery),width,height},depth,fun}
  80.             = depth` mod NrOfColours
  81. where
  82.     depth`    = Calculate fun depth rx ry
  83.     rx        = centerx - width /2.0 + (toReal x * width) / toReal ScreenWidth
  84.     ry        = centery - height/2.0 + (toReal y * height)/ toReal ScreenHeight
  85.     
  86.     Calculate :: !FractalFunction !Int !Real !Real -> Int
  87.     Calculate MSquare maxd rx ry = MandelSquare maxd 0 0.0 0.0 rx ry
  88.                                  where
  89.                                     MandelSquare :: !Int !Int !Real !Real !Real !Real -> Int
  90.                                     MandelSquare maxdepth depth x y bx by
  91.                                     |    maxdepth==depth    = maxdepth
  92.                                     |    sx+sy>2.8        = depth
  93.                                     |    otherwise        = MandelSquare maxdepth (inc depth) (sx-sy-bx) (pxy+pxy-by) bx by
  94.                                     where
  95.                                         sx                = x*x
  96.                                         sy                = y*y
  97.                                         pxy                = x*y
  98.     Calculate MCube   maxd rx ry = MandelCube   maxd 0 (0.0,0.0) (rx,ry)
  99.                                  where
  100.                                     MandelCube :: !Int !Int !ComplexNum !ComplexNum -> Int
  101.                                     MandelCube maxdepth depth zn c 
  102.                                     |    maxdepth==depth        = maxdepth
  103.                                     |    FakeAbsC znp1 > 4.0    = depth
  104.                                     |    otherwise            = MandelCube maxdepth (inc depth) znp1 c
  105.                                     where
  106.                                         znp1                = AddC c (MulC zn (MulC zn zn))
  107.     Calculate MSin    maxd rx ry = MandelSin    maxd 0 (0.0,0.0) (rx,ry)
  108.                                  where
  109.                                     MandelSin :: !Int !Int !ComplexNum !ComplexNum -> Int
  110.                                     MandelSin maxdepth depth zn c
  111.                                     |    maxdepth==depth        = maxdepth
  112.                                     |    FakeAbsC znp1 > 4.0    = depth
  113.                                     |    otherwise            = MandelSin maxdepth (inc depth) znp1 c
  114.                                     where
  115.                                         znp1                = AddC c (SinC zn)
  116.     Calculate MCos    maxd rx ry = MandelCos    maxd 0 (0.0,0.0) (rx,ry)
  117.                                  where
  118.                                     MandelCos :: !Int !Int !ComplexNum !ComplexNum -> Int
  119.                                     MandelCos maxdepth depth zn c
  120.                                     |    maxdepth==depth        = maxdepth
  121.                                     |    FakeAbsC znp1 > 4.0    = depth
  122.                                     |    otherwise            = MandelCos maxdepth (inc depth) znp1 c
  123.                                     where
  124.                                         znp1                = AddC c (CosC zn)
  125.     Calculate MExp    maxd rx ry = MandelExp    maxd 0 (0.0,0.0) (rx,ry)
  126.                                  where
  127.                                     MandelExp :: Int Int ComplexNum ComplexNum -> Int
  128.                                     MandelExp maxdepth depth zn c
  129.                                     |    maxdepth==depth        = maxdepth
  130.                                     |    FakeAbsC znp1 > 4.0    = depth
  131.                                     |    otherwise            = MandelExp maxdepth (inc depth) znp1 c
  132.                                     where
  133.                                         znp1 = AddC c (ExpC zn)
  134.  
  135. // Timer device -> draw one line at a time 
  136. DrawFractal :: TimerState *FractalState IO -> (*FractalState,IO)
  137. DrawFractal _ state=:{drawstate={grain=0}} io
  138.                     = DoStopDrawing {state & drawstate={state.drawstate & grain=1}} io 
  139. DrawFractal _ fstate io
  140.                     = (fstate`,EnableTimer TimerID io`)
  141. where
  142.     (fstate`,io`)    = DrawFractalLine fstate (DisableTimer TimerID io)
  143.     
  144.     // Draw one line of the image.
  145.     DrawFractalLine :: !*FractalState !IO -> (!*FractalState,!IO)
  146.     DrawFractalLine state=:{funstate,drawstate={layer,grain,line}} io 
  147.     |    line>=ScreenHeight    = (SetDrawState {layer=dec layer,grain=grain>>1,line=0} state,io)
  148.     |    otherwise            = (SetDrawState {layer=layer,grain=grain,line=line+grain} state,DrawInWindow MyWindow drawfs io)
  149.                             with
  150.                                 drawfs    = [LazyDrawSpots (0,line) (ScreenWidth,ScreenHeight) grain layer funstate]
  151.     where
  152.         LazyDrawSpots :: !Point !Point !GrainSize !Layer !FunctionState !Picture -> Picture
  153.         LazyDrawSpots point=:(x,y) dim=:(h,v) n l funcs pic
  154.         |    x>h                = pic
  155.         |    drawnspot        = LazyDrawSpots (xn,y) dim n l funcs pic
  156.         |    otherwise        = LazyDrawSpots (xn,y) dim n l funcs (PaintSpot ((x,y),(xn,yn)) value funcs pic)
  157.         where
  158.             drawnspot        = 0==(1 bitand (x bitor y) >> l) && x<>0 && y<>0
  159.             xn                = x+n
  160.             yn                = y+n
  161.             value            = Fractal_color point funcs
  162.  
  163. // Drawing has been stopped -> enable/disable menuitems/menus
  164. DoStopDrawing :: *FractalState IO -> (*FractalState, IO)
  165. DoStopDrawing state io 
  166. #    io    = DisableTimer        TimerID                    io
  167.     io    = EnableMenus        [OptionsID]                io
  168.     io    = DisableMenuItems    [StopDrawID,ContinueID]    io
  169.     io    = EnableMenuItems    [DrawID]                io
  170. =    (state,io)
  171.  
  172. // Set initial layer and grainsize.
  173. InitDrawState :: *FractalState -> *FractalState
  174. InitDrawState state    = SetDrawState {layer=layer,grain=size,line=0} state
  175. where
  176.     (layer,size)    = Log2AndPower (max ScreenHeight ScreenWidth)
  177.     
  178.     Log2AndPower :: !Int -> (!Int,!Int)
  179.     Log2AndPower n
  180.     |    halfpower==n    = (log2_1,halfpower)
  181.     |    otherwise        = (log2,  power)
  182.     where
  183.         power            = 1<<log2
  184.         halfpower        = 1<<log2_1
  185.         log2            = Log2 n
  186.         log2_1            = log2-1
  187.     
  188.     Log2 :: !Int -> Int
  189.     Log2 n
  190.     |    n==1            = 1
  191.     |    otherwise        = (Log2 (n>>1))+1
  192.